﻿unit TCPService;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, TCPEngine,
  TCPListener, ContextFactory, MemBuffer, Engine;

type
  TTCPService = class(TComponent)
  private
    FMaxMemPool: Integer;
    FMaxClientPool: Integer;
    FPort: Integer;
    FMaxWorkPool: Integer;
    FSendSocket: TOnChannelIOEvent;
    FRecvSocket: TOnChannelIOEvent;
    FOpenSocket: TOnChannelDeviceEvent;
    FCloseSocket: TOnChannelDeviceEvent;
    FKeepAlive: Boolean;
    procedure SetKeepAlive(const Value: Boolean);
  protected
    procedure CloseASocket(FChannel: TObject); virtual;
    procedure NewSocket(FChannel: TObject); virtual;
    procedure RecvData(FDIChannel: TObject; FDIBuffer: TIBuffer;
      dwIoSize: Cardinal); virtual;
    procedure SendData(FDIChannel: TObject; FDIBuffer: TIBuffer;
      dwIoSize: Cardinal); virtual;
    function OnCreateClient: TIClientContext; virtual;
    function OnSecurityIP(IPAddress: AnsiString): Boolean; virtual;
  public
    _TCPEngine: TITCPEngine;         //TCP服务引擎
    _TCPListener: TITCPListener;     //TCP侦听器
    function StartService: Boolean;
    procedure StopService;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Port: Integer read FPort write FPort;          //侦听端口
    property MaxMemPool: Integer read FMaxMemPool write FMaxMemPool;    //最大内存池数量
    property MaxClientPool: Integer read FMaxClientPool write FMaxClientPool; //最大客户连接数
    property MaxWorkPool: Integer read FMaxWorkPool write FMaxWorkPool;   //最大工作线程数
    property KeepAlive: Boolean read FKeepAlive write SetKeepAlive;
    property OpenSocket: TOnChannelDeviceEvent read FOpenSocket write FOpenSocket;
    property CloseSocket: TOnChannelDeviceEvent read FCloseSocket write FCloseSocket;
    property RecvSocket: TOnChannelIOEvent read FRecvSocket write FRecvSocket;
    property SendSocket: TOnChannelIOEvent read FSendSocket write FSendSocket;
  end;

  procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('TIOCP', [TTCPService]);
end;

{ TTCPService }

constructor TTCPService.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPort := 8988;
  FMaxMemPool := 2000;
  FMaxClientPool := 1000;
  FMaxWorkPool := 4;
  _TCPEngine := TITCPEngine.Create;
  _TCPEngine.OnChannelOpenEvent := NewSocket;
  _TCPEngine.OnChannelCloseEvent := CloseASocket;
  _TCPEngine.OnChannelRecvEvent := RecvData;
  _TCPEngine.OnChannelSendEvent := SendData;
  _TCPListener := TITCPListener.Create;
  _TCPListener.FOnCreateClientEvent := OnCreateClient;
  _TCPListener.FOnSecurityIPEvent   := OnSecurityIP;
end;

function TTCPService.OnCreateClient: TIClientContext;
begin
  Result := TIClientContext.Create(_TCPEngine);
end;

function TTCPService.OnSecurityIP(IPAddress: AnsiString): Boolean;
begin
//  Result := False;
//  if IPAddress = '127.0.0.1' then
  Result := True;
end;

destructor TTCPService.Destroy;
begin
  FreeAndNil(_TCPListener);
  FreeAndNil(_TCPEngine);
  inherited;
end;

procedure TTCPService.NewSocket(FChannel: TObject);
var
  sIP: string;
begin
  sIP := (FChannel as TIClientContext).RemoteIP;
  if Assigned(FOpenSocket) then FOpenSocket(FChannel);
end;

procedure TTCPService.CloseASocket(FChannel: TObject);
var
  sIP: string;
begin
  sIP := (FChannel as TIClientContext).RemoteIP;
  if Assigned(FCloseSocket) then FCloseSocket(FChannel);
end;

procedure TTCPService.RecvData(FDIChannel: TObject; FDIBuffer: TIBuffer; dwIoSize: Cardinal);
begin
  if Assigned(FRecvSocket) then FRecvSocket(FDIChannel, FDIBuffer, dwIoSize);
end;

procedure TTCPService.SendData(FDIChannel: TObject; FDIBuffer: TIBuffer; dwIoSize: Cardinal);
begin
  if Assigned(FSendSocket) then FSendSocket(FDIChannel, FDIBuffer, dwIoSize);
end;

procedure TTCPService.SetKeepAlive(const Value: Boolean);
begin
  FKeepAlive := Value;
end;

function TTCPService.StartService: Boolean;
begin
  _TCPEngine.MaxMemPool := Self.FMaxMemPool;
  _TCPEngine.WorkThreadPool.ActiveThreads := Self.FMaxWorkPool;
  Result := _TCPEngine.StartEngine;
  _TCPListener.FPort := Self.FPort;
  _TCPListener.FKeepAlive := Self.KeepAlive;
  _TCPListener.FMaxNumConnections := Self.FMaxClientPool;
  if Result then
    Result := _TCPListener.StartListener(_TCPEngine);
end;

procedure TTCPService.StopService;
begin
  _TCPListener.StopListener;
  _TCPEngine.StopEngine;
  _TCPListener.FreeClientContexts;
end;

end.
